home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Tech Arsenal 1
/
Tech Arsenal (Arsenal Computer).ISO
/
tek-02
/
docdem.zip
/
DLLTEST.PAS
< prev
next >
Wrap
Pascal/Delphi Source File
|
1991-04-09
|
4KB
|
155 lines
{************************************************}
{ }
{ Turbo Pascal for Windows }
{ Demo program }
{ Copyright (c) 1991 by Borland International }
{ }
{************************************************}
program DLLTest;
{$R MATH}
uses WinTypes, WinProcs, WObjects, Math;
type
TMyApplication = Object(TApplication)
procedure InitMainWindow; Virtual;
end;
TPaymentDlg = Object(TDialog)
Period, Interest, Term, Principal : Real;
function LoadFields: Boolean;
procedure OK(var Msg: TMessage); virtual id_First + IdOk;
end;
TPrincipalDlg = Object(TDialog)
Payment, Period, Interest, Term: Real;
function LoadFields: Boolean;
procedure OK(var Msg: TMessage); virtual id_First + IdOk;
end;
PMyWindow = ^TMyWindow;
TMyWindow = Object(TWindow)
PaymentDlg: TPaymentDlg;
PrincipalDlg: TPrincipalDlg;
constructor Init(AParent: PWindowsObject; ATitle: PChar);
procedure Payment(var Msg: TMessage); virtual cm_First + 201;
procedure Principal(var Msg: TMessage); virtual cm_First + 202;
end;
function TPaymentDlg.LoadFields: Boolean;
var
E: Integer;
S: String;
begin
LoadFields:=false;
S[0]:=Char(GetDlgItemText(HWindow, 104, @S[1], 20));
Val(S, Interest, E);
If E<>0 then
Exit;
S[0]:=Char(GetDlgItemText(HWindow, 105, @S[1], 20));
Val(S, Term, E);
If E<>0 then
Exit;
S[0]:=Char(GetDlgItemText(HWindow, 112, @S[1], 20));
Val(S, Period, E);
If E<>0 then
Exit;
S[0]:=Char(GetDlgItemText(HWindow, 106, @S[1], 20));
Val(S, Principal, E);
If E<>0 then
Exit;
LoadFields:=true;
end;
procedure TPaymentDlg.Ok(var Msg: TMessage);
var
S: String;
begin
if not LoadFields then
WriteError(HWindow, 'All fields must have values')
else
begin
Str(Payments(Period, Interest, Term, Principal):10:2, S);
S:=S+#0;
While S[1]=' ' do
Delete(S, 1, 1);
SetDlgItemText(HWindow, 113, @S[1]);
end;
end;
function TPrincipalDlg.LoadFields: Boolean;
var
E: Integer;
S: String;
begin
LoadFields:=false;
S[0]:=Char(GetDlgItemText(HWindow, 104, @S[1], 20));
Val(S, Interest, E);
If E<>0 then
Exit;
S[0]:=Char(GetDlgItemText(HWindow, 105, @S[1], 20));
Val(S, Term, E);
If E<>0 then
Exit;
S[0]:=Char(GetDlgItemText(HWindow, 112, @S[1], 20));
Val(S, Period, E);
If E<>0 then
Exit;
S[0]:=Char(GetDlgItemText(HWindow, 106, @S[1], 20));
Val(S, Payment, E);
If E<>0 then
Exit;
LoadFields:=true;
end;
procedure TPrincipalDlg.Ok(var Msg: TMessage);
var
S: String;
begin
if not LoadFields then
WriteError(HWindow, 'All fields must have values')
else
begin
Str(Principals(Payment, Period, Interest, Term):10:2, S);
S:=S+#0;
While S[1]=' ' do
Delete(S, 1, 1);
SetDlgItemText(HWindow, 113, @S[1]);
end;
end;
constructor TMyWindow.Init(AParent: PWindowsObject; ATitle: PChar);
begin
TWindow.Init(AParent, ATitle);
Attr.Menu := LoadMenu(HInstance, 'Menu');
end;
procedure TMyWindow.Payment(var Msg: TMessage);
begin
PaymentDlg.Init(@Self, 'PaymentDlg');
PaymentDlg.Execute;
PaymentDlg.Done;
end;
procedure TMyWindow.Principal(var Msg: TMessage);
begin
PrincipalDlg.Init(@Self, 'PrincipalDlg');
PrincipalDlg.Execute;
PrincipalDlg.Done;
end;
procedure TMyApplication.InitMainWindow;
begin
MainWindow:=New(PMyWindow, Init(nil, 'Title'));
end;
var
MyApplication: TMyApplication;
begin
MyApplication.Init('DLLTest');
MyApplication.Run;
MyApplication.Done;
end.